home *** CD-ROM | disk | FTP | other *** search
/ Amiga Tools 5 / Amiga Tools 5.iso / tools / developer-tools / andere sprachen / oberonv4 / oberon-src / system / iconelems.mod (.txt) < prev    next >
Encoding:
Oberon Text  |  1995-06-10  |  8.2 KB  |  240 lines
  1. Syntax24.Scn.Fnt
  2. Syntax10.Scn.Fnt
  3. Syntax10i.Scn.Fnt
  4. (* Notify Ralf for maintenance of Non-FPU source *)
  5. MODULE IconElems; (* gri 18.3.91 / 28.9.93 *)
  6.     IMPORT Input, Display, Oberon, Math, Viewers, Files, Printer, Texts, TextFrames, TextPrinter;
  7.     CONST
  8.         IStag = 753; (* icon stretch tag *)
  9.         left = 2; middle = 1; right = 0; (* mouse keys *)
  10.         HSide = MAX(SET)+1; Side = 2*HSide; PDot = 3; (* dimensions *)
  11.         MaxN = 64; Sleep = 100; (* in ms *)
  12.     TYPE
  13.         Icon = ARRAY 2 OF RECORD
  14.             addr: LONGINT;
  15.             image: ARRAY Side+1 OF SET
  16.         END;
  17.         Elem = POINTER TO ElemDesc;
  18.         ElemDesc = RECORD (Texts.ElemDesc)
  19.         END;
  20.         Frame = POINTER TO RECORD(Display.FrameDesc) col: SHORTINT END;
  21.         NotifyMsg = RECORD(TextFrames.NotifyMsg) END;
  22.         N: LONGINT; (* no. of figurs *)
  23.         Task: Oberon.Task;
  24.         State: LONGINT; (* actual figure state *)
  25.         Fig: ARRAY MaxN OF Icon;
  26.     PROCEDURE EmptyFig;
  27.         VAR j: INTEGER;
  28.     BEGIN N := 1; j := 1;
  29.         WHILE j <= Side DO
  30.             Fig[0, 0].image[j] := {};
  31.             Fig[0, 1].image[j] := {};
  32.             INC(j)
  33.         END;
  34.         Fig[0, 0].addr := Display.NewPattern(Fig[0, 0].image, HSide, Side);
  35.         Fig[0, 1].addr := Display.NewPattern(Fig[0, 1].image, HSide, Side)
  36.     END EmptyFig;
  37.     PROCEDURE LoadFig (file: ARRAY OF CHAR); (* read portable file format *)
  38.         VAR F: Files.File; R: Files.Rider; i, j: INTEGER;
  39.         PROCEDURE ReadInt (VAR x: LONGINT);
  40.             VAR n: LONGINT; i: SHORTINT; ch: CHAR;
  41.         BEGIN i := 0; n := 0; Files.Read(R, ch);
  42.             WHILE ORD(ch) >= 128 DO INC(n, ASH(ORD(ch) - 128, i)); INC(i, 7); Files.Read(R, ch) END;
  43.             x := n + ASH(ORD(ch) MOD 64 - ORD(ch) DIV 64 * 64, i)
  44.         END ReadInt;
  45.         PROCEDURE ReadSet (VAR s: SET);
  46.             VAR x: LONGINT; i: INTEGER;
  47.         BEGIN ReadInt(x); s := {}; i := 0;
  48.             WHILE i < 32 DO
  49.                 IF ODD(x) THEN INCL(s, i) END;
  50.                 x := x DIV 2; INC(i)
  51.             END
  52.         END ReadSet;
  53.     BEGIN F := Files.Old(file);
  54.         IF F = NIL THEN EmptyFig; RETURN END;
  55.         Files.Set(R, F, 0); ReadInt(N);
  56.         IF N # IStag THEN EmptyFig; RETURN END;
  57.         ReadInt(N); i := 0;
  58.         WHILE i <= N DO j := 1;
  59.             WHILE j <= Side DO
  60.                 ReadSet(Fig[i, 0].image[j]);
  61.                 ReadSet(Fig[i, 1].image[j]);
  62.                 INC(j)
  63.             END;
  64.             Fig[i, 0].addr := Display.NewPattern(Fig[i, 0].image, HSide, Side);
  65.             Fig[i, 1].addr := Display.NewPattern(Fig[i, 1].image, HSide, Side);
  66.             INC(i)
  67.         END
  68.     END LoadFig;
  69.     PROCEDURE Draw (VAR icn: Icon; x, y, color: INTEGER);
  70.     BEGIN
  71.         Display.CopyPattern(color, icn[0].addr, x, y, Display.invert);
  72.         Display.CopyPattern(color, icn[1].addr, x + HSide, y, Display.invert)
  73.     END Draw;
  74.     PROCEDURE Print (VAR icn: Icon; x, y: INTEGER);
  75.         VAR i: INTEGER;
  76.         PROCEDURE PrintLine (x, y: INTEGER; line: SET);
  77.             VAR i, i0: INTEGER;
  78.         BEGIN i := 0;
  79.             WHILE i < HSide DO
  80.                 IF i IN line THEN i0 := i; INC(i);
  81.                     WHILE (i < HSide) & (i IN line) DO INC(i) END;
  82.                     Printer.ReplConst(x + i0*PDot, y, (i-i0)*PDot, PDot)
  83.                 END;
  84.                 INC(i)
  85.             END
  86.         END PrintLine;
  87.     BEGIN i := 0;
  88.         WHILE i < Side DO
  89.             PrintLine(x, y + i*PDot, icn[0].image[i+1]);
  90.             PrintLine(x + HSide*PDot, y + i*PDot, icn[1].image[i+1]);
  91.             INC(i)
  92.         END
  93.     END Print;
  94.     PROCEDURE HotSpot (X, Y, W, H, X0, Y0: INTEGER);
  95.         CONST d = 6;
  96.         VAR dx, dy: LONGINT; r: INTEGER;
  97.         PROCEDURE Block (x, y, w, h, col, mode: INTEGER);
  98.         BEGIN
  99.             IF x < X THEN DEC(w, X-x); x := X END;
  100.             IF x+w > X+W THEN w := X+W-x END;
  101.             IF w <= 0 THEN RETURN END;
  102.             IF y < Y THEN DEC(h, Y-y); y := Y END;
  103.             IF y+h > Y+H THEN h := Y+H-y END;
  104.             IF h <= 0 THEN RETURN END;
  105.             Display.ReplConst(col, x, y, w, h, mode)
  106.         END Block;
  107.         PROCEDURE Dot4 (x1, x2, y1, y2, col, mode: INTEGER);
  108.             CONST r = (d+1) DIV 2;
  109.         BEGIN
  110.             Block(x1-r, y1-r, 2*r+1, 2*r+1, col, mode);
  111.             Block(x1-r, y2-r, 2*r+1, 2*r+1, col, mode);
  112.             Block(x2-r, y1-r, 2*r+1, 2*r+1, col, mode);
  113.             Block(x2-r, y2-r, 2*r+1, 2*r+1, col, mode)
  114.         END Dot4;
  115.         PROCEDURE Circle (X, Y, R, col, mode: INTEGER);
  116.             VAR x, y, dx, dy, d: INTEGER;
  117.         BEGIN
  118.             x := R; y := 0; dx := 8*(x-1); dy := 8*y+4; d := 1 - 4*R;
  119.             WHILE x > y DO
  120.                 Dot4(X-x-1, X+x, Y-y-1, Y+y, col, mode);
  121.                 Dot4(X-y-1, X+y, Y-x-1, Y+x, col, mode);
  122.                 INC(d, dy); INC(dy, 8); INC(y);
  123.                 IF d >= 0 THEN DEC(d, dx); DEC(dx, 8); DEC(x) END
  124.             END;
  125.             IF x = y THEN Dot4(X-x-1, X+x, Y-y-1, Y+y, col, mode) END
  126.         END Circle;
  127.     BEGIN
  128.         IF X0-X > X+W-X0 THEN dx := X0-X ELSE dx := X+W-X0 END;
  129.         IF Y0-Y > Y+H-Y0 THEN dy := Y0-Y ELSE dy := Y+H-Y0 END;
  130.         r := SHORT(ENTIER(Math.sqrt(dx*dx + dy*dy)));
  131.         WHILE r > 0 DO Circle(X0, Y0, r, Display.black, Display.replace); DEC(r, d) END
  132.     END HotSpot;
  133.     PROCEDURE SaveScreen (x0, y0: INTEGER; keys: SET; col: SHORTINT);
  134.         VAR sum: SET; x, y, w, h: INTEGER; msg: Viewers.ViewerMsg; wakeUp: LONGINT;
  135.     BEGIN
  136.         Display.ReplConst(Display.white, x0, y0, Side, Side, Display.invert); sum := keys;
  137.         REPEAT
  138.             Input.Mouse(keys, x, y); sum := sum+keys; 
  139.             Oberon.DrawCursor(Oberon.Mouse, Oberon.Arrow, x, y)
  140.         UNTIL keys = {};
  141.         Display.ReplConst(Display.white, x0, y0, Side, Side, Display.invert);
  142.         IF sum # {left, middle, right} THEN
  143.             x := Oberon.UserTrack(x0); w := Oberon.DisplayWidth(x0);
  144.             y := Display.Bottom; h := Oberon.DisplayHeight(x0);
  145.             Oberon.RemoveMarks(x, y, w, h);
  146.             msg.id := Viewers.suspend; Viewers.Broadcast(msg);
  147.             HotSpot(x, y, w, h, x0 + Side DIV 2, y0 + Side DIV 2);
  148.             REPEAT
  149.                 Display.ReplConst(Display.black, x0, y0, Side, Side, Display.replace);
  150.                 INC(State); INC(x0, 10);
  151.                 IF x0+Side > x+w THEN x0 := x; INC(y0, Side);
  152.                     IF y0+Side > y+h THEN y0 := y END
  153.                 END;
  154.                 Draw(Fig[State MOD N], x0, y0, col);
  155.                 wakeUp := Oberon.Time() + Sleep*Input.TimeUnit DIV 1000;
  156.                 REPEAT UNTIL Oberon.Time() >= wakeUp
  157.             UNTIL Input.Available() > 0;
  158.             msg.id := Viewers.restore; Viewers.Broadcast(msg)
  159.         END
  160.     END SaveScreen;
  161.     PROCEDURE HandleFrame (F: Display.Frame; VAR M: Display.FrameMsg);
  162.         VAR r: INTEGER;
  163.     BEGIN
  164.         WITH F: Frame DO
  165.             IF M IS NotifyMsg THEN
  166.                 WITH M: NotifyMsg DO
  167.                     Draw(Fig[(State-1) MOD N], F.X, F.Y, F.col);
  168.                     Draw(Fig[State MOD N], F.X, F.Y, F.col)
  169.                 END
  170.             ELSIF M IS Oberon.InputMsg THEN
  171.                 WITH M: Oberon.InputMsg DO
  172.                     IF M.id = Oberon.track THEN Oberon.DrawCursor(Oberon.Mouse, Oberon.Arrow, M.X, M.Y) END
  173.                 END
  174.             END
  175.         END
  176.     END HandleFrame;
  177.     PROCEDURE Handle (E: Texts.Elem; VAR msg: Texts.ElemMsg);
  178.         VAR e: Elem; ch: CHAR; F: Frame;
  179.     BEGIN
  180.         WITH E: Elem DO
  181.             IF msg IS TextFrames.DisplayMsg THEN
  182.                 WITH msg: TextFrames.DisplayMsg DO
  183.                     IF ~msg.prepare THEN
  184.                         Draw(Fig[State MOD N], msg.X0, msg.Y0, msg.col);
  185.                         NEW(F); F.handle := HandleFrame; F.X := msg.X0; F.Y := msg.Y0; F.W := 64; F.H := 64; F.col := msg.col;
  186.                         msg.elemFrame := F
  187.                     END
  188.                 END
  189.             ELSIF msg IS TextPrinter.PrintMsg THEN
  190.                 WITH msg: TextPrinter.PrintMsg DO
  191.                     IF msg.prepare THEN
  192.                         E.W := Side * TextPrinter.Unit * PDot; E.H := E.W
  193.                     ELSE
  194.                         Print(Fig[State MOD N], msg.X0, msg.Y0);
  195.                         E.W := Side * TextFrames.Unit; E.H := E.W
  196.                     END
  197.                 END
  198.             ELSIF msg IS Texts.CopyMsg THEN
  199.                 NEW(e); Texts.CopyElem(E, e); msg(Texts.CopyMsg).e := e
  200.             ELSIF msg IS TextFrames.TrackMsg THEN
  201.                 WITH msg: TextFrames.TrackMsg DO
  202.                     IF middle IN msg.keys THEN SaveScreen(msg.X0, msg.Y0, msg.keys, msg.col) END
  203.                 END
  204.             ELSIF msg IS Texts.IdentifyMsg THEN
  205.                 WITH msg: Texts.IdentifyMsg DO
  206.                     msg.mod := "IconElems"; msg.proc := "New"
  207.                 END
  208.             ELSIF msg IS Texts.FileMsg THEN
  209.                 WITH msg: Texts.FileMsg DO
  210.                     IF msg.id = Texts.load THEN Files.Read(msg.r, ch) (* ignore in this version *)
  211.                     ELSIF msg.id = Texts.store THEN Files.Write(msg.r, 0X); (* version tag: used for future extensions *)
  212.                     END
  213.                 END
  214.             END
  215.         END
  216.     END Handle;
  217.     PROCEDURE Step;
  218.         VAR msg: NotifyMsg;
  219.     BEGIN
  220.         INC(State); Viewers.Broadcast(msg);
  221.         Oberon.CurTask.time := Oberon.Time() + Sleep*Input.TimeUnit DIV 1000
  222.     END Step;
  223.     PROCEDURE New*;
  224.         VAR E: Elem;
  225.     BEGIN NEW(E); E.handle := Handle; Texts.new := E; Oberon.Install(Task)
  226.     END New;
  227.     PROCEDURE Insert*;
  228.         VAR E: Elem; m: TextFrames.InsertElemMsg;
  229.     BEGIN NEW(E); E.W := Side * TextFrames.Unit; E.H := E.W; E.handle := Handle; m.e := E;
  230.         Oberon.FocusViewer.handle(Oberon.FocusViewer, m);
  231.         Oberon.Install(Task)
  232.     END Insert;
  233.     PROCEDURE Stop*;
  234.     BEGIN Oberon.Remove(Task);
  235.     END Stop;
  236. BEGIN
  237.     LoadFig("IconElems.Icon"); State := 0;
  238.     NEW(Task); Task.safe := FALSE; Task.time := 0; Task.handle := Step; Oberon.Install(Task)
  239. END IconElems.
  240.